home *** CD-ROM | disk | FTP | other *** search
/ Resource Library: Multimedia / Resource Library: Multimedia.iso / utils / graphic / viewers / general / amiga / sprsh31b / loadsham.mod < prev    next >
Encoding:
Modula Implementation  |  1989-10-20  |  8.8 KB  |  267 lines
  1. IMPLEMENTATION MODULE LoadSHAM;
  2.  
  3. (*======================================================================*)
  4. (*                    Amiga M2Sprint Support Routines                   *)
  5. (*======================================================================*)
  6. (*         ⌐ Copyright 1989 Robert Salesas, All Rights Reserved         *)
  7. (*        Re-Distribute as you wish but DO NOT alter the contents       *)
  8. (*            of this file.  Moral Rights remain my property.           *)
  9. (*======================================================================*)
  10. (*      Version: 3.20           Author : Robert Salesas                 *)
  11. (*      Date   : 19-Oct-89      Changes: Original                       *)
  12. (*======================================================================*)
  13.  
  14. (*$L+*)
  15.  
  16. FROM SYSTEM           IMPORT  ADR, ADDRESS, BYTE, SHIFT, TSIZE, WORD;
  17. FROM RunTime          IMPORT  IntuitionBase;
  18. FROM Intuition        IMPORT  ScreenPtr, RethinkDisplay;
  19. FROM IntuitionBase    IMPORT  LockIBase, UnlockIBase, IntuitionBaseRecPtr;
  20. FROM Graphics         IMPORT  BitMap;
  21. FROM Views            IMPORT  ColorTable, ColorTablePtr, LoadRGB4, SetRGB4,
  22.                               ViewModes, ViewModeSet;
  23. FROM BufferedDOS      IMPORT  BufHandle, BufRead,
  24.                               BufSeek, OffsetBeginning, OffsetCurrent;
  25. FROM IFF              IMPORT  FORM, GroupHeader, ChunkHeader;
  26. FROM ILBM             IMPORT  IDILBM, IDBMHD, IDCAMG, IDCMAP, IDBODY,
  27.                               Compression, BitMapHeader, Masking,
  28.                               ColorRegister;
  29. FROM Memory           IMPORT  AllocMem, MemReqSet, MemReqs;
  30. FROM Copper           IMPORT  UCopListPtr, UCopList, CWAIT, CMOVE, CEND;
  31. FROM CustomHardware   IMPORT  custom;
  32.  
  33.  
  34.   PROCEDURE LoadSHAMPicture(Fh : BufHandle;  GetScreen : GetScreenProc;
  35.                             Registers : SHAMRegsPtr) : BOOLEAN;
  36.   CONST
  37.     IDSHAM = 5348414DH;
  38.  
  39.   VAR
  40.     IORet             :   LONGINT;
  41.     gpH               :   GroupHeader;
  42.     ckH               :   ChunkHeader;
  43.     BMHeader          :   BitMapHeader;
  44.     BodySize          :   LONGINT;
  45.     Sp                :   ScreenPtr;
  46.  
  47.  
  48.     PROCEDURE ProcessBMHD() : BOOLEAN;
  49.     BEGIN
  50.       IF (BufRead(Fh, ADR(BMHeader), ckH.ckSize) = ckH.ckSize) THEN
  51.         IF (BMHeader.compression <= cmpByteRun1) THEN
  52.           IF (BMHeader.masking = mskNone) OR (BMHeader.masking = mskHasTransparentColor)  THEN
  53.             RETURN FALSE
  54.           END;
  55.         END;
  56.       END;
  57.       RETURN TRUE;
  58.     END ProcessBMHD;
  59.  
  60.     PROCEDURE ProcessSHAM() : BOOLEAN;
  61. (*
  62.     I would like to take the time to expressly thank Rhett Anderson of
  63.     Compute's! Amiga Resource.  It is thanx to him that this SHAM display
  64.     procedure exists.  Although not identical to his, it is still derived
  65.     or at least influenced by his work.  Again, thanx a million Rhett!
  66. *)
  67.     VAR
  68.       Version   :   CARDINAL;
  69.       I, J      :   CARDINAL;
  70.       UCop      :   UCopListPtr;
  71.       IBase     :   IntuitionBaseRecPtr;
  72.       IBLock    :   LONGCARD;
  73.       ViewDx    :   CARDINAL;
  74.  
  75.     BEGIN
  76.       IORet := BufRead(Fh, ADR(Version), 2);
  77.       IF (Version = 0) THEN
  78.         IF (BufRead(Fh, Registers, SIZE(Registers^)) = SIZE(Registers^)) THEN
  79.  
  80.           IBLock := LockIBase(0);
  81.           IBase := IntuitionBase;
  82.           ViewDx := IBase^.ViewLord.DxOffset;
  83.           UnlockIBase(IBLock);
  84.  
  85.           SetRGB4(ADR(Sp^.VPort), 0, 0, 0, 0);
  86.           FOR I := 1 TO 15 DO
  87.             SetRGB4(ADR(Sp^.VPort), I, Registers^[0, I] DIV 256,
  88.                                        Registers^[0, I] DIV 16 MOD 16,
  89.                                        Registers^[0, I] MOD 16);
  90.           END;
  91.  
  92.           UCop := AllocMem(TSIZE(UCopList), MemReqSet{MemChip,MemClear});
  93.           IF (UCop # NIL) THEN
  94.             FOR I := 1 TO 199 DO
  95.               IF (BMHeader.h > 200) THEN
  96.                 IF (ViewDx < 114) THEN
  97.                   CWAIT(UCop, I + I - 2, (SHIFT(ViewDx, -2) + 188) MOD 228);
  98.                 ELSIF (ViewDx < 129) THEN
  99.                   CWAIT(UCop, I + I - 2, (SHIFT(ViewDx, -2) + 192) MOD 228);
  100.                 ELSE
  101.                   CWAIT(UCop, I + I, (SHIFT(ViewDx, -2) +196) MOD 228);
  102.                 END;
  103.               ELSE
  104.                 IF (ViewDx < 128) THEN
  105.                   CWAIT(UCop, I - 1, (SHIFT(ViewDx, -2) + 188) MOD 228);
  106.                 ELSE
  107.                   CWAIT(UCop, I, (SHIFT(ViewDx, -2) + 196) MOD 228);
  108.                 END;
  109.               END;
  110.               FOR J := 1 TO 15 DO
  111.                 CMOVE(UCop, ADR(custom^.color[J]), Registers^[I, J]);
  112.               END;
  113.             END;
  114.             CEND(UCop);
  115.             Sp^.VPort.UCopIns := UCop;
  116.             RethinkDisplay;
  117.             RETURN FALSE;
  118.           END;
  119.         END;
  120.       END;
  121.       RETURN TRUE;
  122.     END ProcessSHAM;
  123.  
  124.     PROCEDURE ProcessCMAP;
  125.     VAR
  126.       Table           :   ColorTablePtr;
  127.       TableCnt        :   CARDINAL;
  128.       CTemp           :   ColorRegister;
  129.       L1              :   CARDINAL;
  130.  
  131.     BEGIN
  132.       Table := Sp^.VPort.ColorMap^.ColorTable;
  133.       TableCnt := ckH.ckSize DIV 3;
  134.       IF (TableCnt > 32) THEN
  135.         TableCnt := 32;
  136.       END;
  137.       FOR L1 := 0 TO (TableCnt - 1) DO
  138.         IORet := BufRead(Fh, ADR(CTemp), 3);
  139.         Table^[L1] := (CARDINAL(CTemp.red) DIV 16) * 256 +
  140.                       (CARDINAL(CTemp.green) DIV 16) * 16 +
  141.                       (CARDINAL(CTemp.blue) DIV 16);
  142.       END;
  143.       IORet := BufSeek(Fh, ckH.ckSize - LONGINT(TableCnt * 3), OffsetCurrent);
  144.       LoadRGB4(ADR(Sp^.VPort), Table, TableCnt);
  145.     END ProcessCMAP;
  146.  
  147.     PROCEDURE GetBODY() : BOOLEAN;
  148.     VAR
  149.       R, P, N,
  150.       DRowSize        :   INTEGER;
  151.       RowSize         :   INTEGER;
  152.       SrcByte         :   BYTE;
  153.       SrcSize         :   LONGINT;
  154.       BMap            :   BitMap;
  155.       DestPtr         :   POINTER TO BYTE;
  156.  
  157.     BEGIN
  158.       IF (BodySize = 0) THEN
  159.         RETURN TRUE;
  160.       END;
  161.       SrcSize := BodySize;
  162.       BMap := Sp^.BMap;
  163.       DRowSize := (INTEGER(BMHeader.w) + 7) DIV 8;
  164.       FOR R := 0 TO INTEGER(BMHeader.h - 1) DO
  165.         FOR P := 0 TO (INTEGER(BMHeader.nPlanes) - 1) DO
  166.           RowSize := DRowSize;
  167.           IF ((RowSize MOD 2) # 0) THEN
  168.             INC(RowSize, 1);
  169.           END;
  170.           DestPtr := BMap.Planes[P] + ADDRESS((R * DRowSize));
  171.           IF (BMHeader.compression = cmpNone) THEN
  172.             IF (BufRead(Fh, DestPtr, RowSize) = -1) THEN
  173.               RETURN FALSE;
  174.             END;
  175.           ELSE
  176.             REPEAT
  177.               DEC(SrcSize);
  178.               IF (BufRead(Fh, ADR(SrcByte), 1) = -1) OR (SrcSize <= 0) THEN
  179.                 RETURN FALSE;
  180.               END;
  181.               N := INTEGER(SrcByte);
  182.               IF (N > 127) THEN
  183.                 INC(N, 0FF00H);
  184.               END;
  185.               IF (N < 0) THEN
  186.                 IF (N # -128) THEN
  187.                   N := ABS(N) + 1;
  188.                   DEC(SrcSize);
  189.                   IF (BufRead(Fh, ADR(SrcByte), 1) = -1) THEN
  190.                     RETURN FALSE;
  191.                   END;
  192.                   REPEAT
  193.                     DestPtr^ := SrcByte;
  194.                     DEC(N); INC(DestPtr); DEC(RowSize);
  195.                   UNTIL (N <= 0);
  196.                 END;
  197.               ELSE
  198.                 INC(N);
  199.                 REPEAT
  200.                   DEC(SrcSize);
  201.                   IF (BufRead(Fh, ADR(SrcByte), 1) = -1) THEN
  202.                     RETURN FALSE;
  203.                   END;
  204.                   DestPtr^ := SrcByte;
  205.                   DEC(N); INC(DestPtr); DEC(RowSize);
  206.                 UNTIL (N <= 0);
  207.               END;
  208.             UNTIL (RowSize <= 0) OR (SrcSize <= 0);
  209.           END;
  210.         END;
  211.       END;
  212.       RETURN TRUE;
  213.     END GetBODY;
  214.  
  215.     PROCEDURE ProcessChunks() : BOOLEAN;
  216.     VAR
  217.       IsSHAM,
  218.       ckError       :   BOOLEAN;
  219.  
  220.     BEGIN
  221.       ckError := FALSE;
  222.       IsSHAM := FALSE;
  223.       IORet := BufRead(Fh, ADR(gpH), 12);
  224.       IF (gpH.ckID = FORM) AND (gpH.grpSubID = IDILBM) THEN
  225.         REPEAT
  226.           IORet := BufRead(Fh, ADR(ckH), 8);
  227.           IF (ckH.ckID = IDBMHD) THEN
  228.             ckError := ProcessBMHD();
  229.             IF (NOT ckError) THEN
  230.               Sp := GetScreen(BMHeader.h > 200);
  231.               IF (Sp = NIL) THEN
  232.                 ckError := TRUE;
  233.               END;
  234.             END;
  235.           ELSIF (ckH.ckID = IDCMAP) THEN
  236.             ProcessCMAP;
  237.           ELSIF (ckH.ckID = IDSHAM) THEN
  238.             ckError := ProcessSHAM();
  239.             IsSHAM := TRUE;
  240.           ELSIF (ckH.ckID = IDBODY) THEN
  241.             BodySize := ckH.ckSize;
  242.             IF IsSHAM THEN
  243.               RETURN GetBODY();
  244.             ELSE
  245.               RETURN FALSE;
  246.             END;
  247.           ELSE
  248.             IF ((ckH.ckSize MOD 2) # 0) THEN
  249.               INC(ckH.ckSize, 1);
  250.             END;
  251.             IF (BufSeek(Fh, ckH.ckSize, OffsetCurrent) = -1) THEN
  252.               RETURN FALSE;
  253.             END;
  254.           END;
  255.         UNTIL (ckError = TRUE);
  256.       END;
  257.       RETURN FALSE;
  258.     END ProcessChunks;
  259.  
  260.   BEGIN
  261.     IF (Registers # NIL) THEN
  262.       RETURN ProcessChunks();
  263.     END;
  264.     RETURN FALSE;
  265.   END LoadSHAMPicture;
  266.  
  267. END LoadSHAM.